home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / dev / amos / amos_col.lha / AMOS-COL / OPEN_FONT.amos / OPEN_FONT.amosSourceCode
AMOS Source Code  |  1980-01-10  |  1KB  |  51 lines
  1. 'By Delta/Opium
  2. '
  3. '�ukasz ï¿½elezny
  4. 'ul. W�oska 4D/6 
  5. '42-612 Tarnowskie G�ry  
  6. 'Poland
  7. '
  8. 'Date: 05.1997 
  9. '
  10. OPEN_FONT["pearl",8]
  11. Procedure OPEN_FONT[NAZWA$,ROZMIAR]
  12.    BLAD=0
  13.    If Lower$(Right$(NAZWA$,5))<>".font"
  14.       NAZWA$=NAZWA$+".font"
  15.    End If 
  16.    NAZWA$=NAZWA$+Chr$(0)
  17.    Dreg(0)=7 : Dreg(1)=0
  18.    ADRES=Execall(-198)
  19.    If ADRES=0 Then BLAD=24
  20.    Loke ADRES,Varptr(NAZWA$)
  21.    Doke ADRES+4,ROZMIAR
  22.    Doke ADRES+6,0
  23.    FONT=Gfxcall(-72)
  24.    If FONT=0
  25.       Lib Open 1,"diskfont.library",0
  26.       Areg(0)=ADRES : Areg(1)=ADRES
  27.       FONT=Lib Call(1,-30)
  28.       If FONT=0 : BLAD=44 : End If 
  29.    Else 
  30.       BLAD=44
  31.    End If 
  32.    If ADRES
  33.       Areg(1)=ADRES
  34.       Dreg(0)=7
  35.       X=Execall(-210)
  36.    End If 
  37.    If BLAD=0
  38.       Get Rom Fonts 
  39.       FONT=0
  40.       N$=Upper$(Left$(NAZWA$,Len(NAZWA$)-6))
  41.       Repeat 
  42.          Inc FONT
  43.          A$=Upper$(Font$(FONT))
  44.          A$=Left$(A$,Instr(A$,".FONT")-1)
  45.          A=Val(Mid$(Font$(FONT),31,5))
  46.       Until(A$=N$ and A=ROZMIAR) or(A$="")
  47.    Else 
  48.       Error BLAD
  49.    End If 
  50. End Proc[FONT]
  51. Set Font Param